home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / RichEdit / OleRichEdit.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-08-06  |  5.7 KB  |  186 lines
  1. unit OleRichEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TOleRichEdit = class(TRichEdit)
  11.   protected
  12.     procedure CreateHandle; override;
  13.   end;
  14.  
  15. procedure Register;
  16.  
  17. implementation
  18.  
  19. {$B-}
  20. uses
  21.   RichEdit, ActiveX, OleCtnrs, ComObj, Menus;
  22.  
  23. type
  24.   IRichEditOleCallback = interface(IUnknown)
  25.     ['{00020D03-0000-0000-C000-000000000046}']
  26.     function GetNewStorage: IStorage; safecall;
  27.     procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
  28.       out Doc: IOleInPlaceUIWindow; var FrameInfo: TOleInPlaceFrameInfo); safecall;
  29.     procedure ShowContainerUI(fShow: Bool); safecall;
  30.     procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
  31.     procedure DeleteObject(OleObj: IOleObject); safecall;
  32.     procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
  33.       reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
  34.     function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
  35.     function GetClipboardData(const ChRg: TCharRange; reCO: DWord; out DataObj: IDataObject): HResult; stdcall;
  36.     procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
  37.       var dwEffect: DWord); safecall;
  38.     procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
  39.       const ChRg: TCharRange; var Menu: HMenu); safecall;
  40.   end;
  41.  
  42.   TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback)
  43.   private
  44.     FOwner: TRichEdit;
  45.   protected
  46.     { IRichEditOleCallback }
  47.     function GetNewStorage: IStorage; safecall;
  48.     procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
  49.       out Doc: IOleInPlaceUIWindow; var FrameInfo: TOleInPlaceFrameInfo); safecall;
  50.     procedure ShowContainerUI(fShow: Bool); safecall;
  51.     procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
  52.     procedure DeleteObject(OleObj: IOleObject); safecall;
  53.     procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
  54.       reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
  55.     function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
  56.     function GetClipboardData(const ChRg: TCharRange; reCO: DWord; out DataObj: IDataObject): HResult; stdcall;
  57.     procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
  58.       var dwEffect: DWord); safecall;
  59.     procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
  60.       const ChRg: TCharRange; var Menu: HMenu); safecall;
  61.   public
  62.     constructor Create(Owner: TRichEdit);
  63.     destructor Destroy; override;
  64.   end;
  65.  
  66. { TRichEditOleCallback }
  67.  
  68. constructor TRichEditOleCallback.Create(Owner: TRichEdit);
  69. begin
  70.   inherited Create;
  71.   FOwner := Owner
  72. end;
  73.  
  74. destructor TRichEditOleCallback.Destroy;
  75. var
  76.   Form: TCustomForm;
  77. begin
  78.   Form := GetParentForm(FOwner);
  79.   if Assigned(Form) and Assigned(Form.OleFormObject) then
  80.     (Form.OleFormObject as IOleInPlaceUIWindow).SetActiveObject(nil, nil);
  81.   inherited;
  82. end;
  83.  
  84. function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: Bool): HResult;
  85. begin
  86.   Result := E_NOTIMPL
  87. end;
  88.  
  89. procedure TRichEditOleCallback.DeleteObject(OleObj: IOleObject);
  90. begin
  91.   OleObj.Close(OLECLOSE_NOSAVE)
  92. end;
  93.  
  94. function TRichEditOleCallback.GetClipboardData(const ChRg: TCharRange; reCO: DWord; out DataObj: IDataObject): HResult;
  95. begin
  96.   Result := E_NOTIMPL
  97. end;
  98.  
  99. procedure TRichEditOleCallback.GetContextMenu(SelType: Word;
  100.   OleObj: IOleObject; const ChRg: TCharRange; var Menu: HMenu);
  101. begin
  102.   Menu := 0
  103. end;
  104.  
  105. procedure TRichEditOleCallback.GetDragDropEffect(fDrag: Bool;
  106.   grfKeyState: DWord; var dwEffect: DWord);
  107. begin
  108.   //Use normal effect (stored in dwEffect)
  109. end;
  110.  
  111. procedure TRichEditOleCallback.GetInPlaceContext(
  112.   out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow;
  113.   var FrameInfo: TOleInPlaceFrameInfo);
  114. var
  115.   Form: TCustomForm;
  116. begin
  117.   //Get richedit's underlying form
  118.   Form := ValidParentForm(FOwner);
  119.   //Ensure there is a TOleForm object
  120.   if Form.OleFormObject = nil then
  121.     TOleForm.Create(Form);
  122.   //Get relevant frame interface
  123.   Frame := Form.OleFormObject as IOleInPlaceFrame;
  124.   Doc := nil; //Document window is same as frame window
  125.   FrameInfo.hWndFrame := Form.Handle;
  126.   FrameInfo.fMDIApp := False;
  127.   FrameInfo.hAccel := 0;
  128.   FrameInfo.cAccelEntries := 0;
  129. end;
  130.  
  131. function TRichEditOleCallback.GetNewStorage: IStorage;
  132. var
  133.   LockBytes: ILockBytes;
  134. begin
  135.   //Basically copied from TOleContainer.CreateStorage
  136.   OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
  137.   OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
  138.     STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Result));
  139. end;
  140.  
  141. procedure TRichEditOleCallback.QueryAcceptData(dataobj: IDataObject;
  142.   var cfFormat: TClipFormat; reCO: DWord; fReally: Bool;
  143.   hMetaPict: HGlobal);
  144. begin
  145.   //Accept anything
  146. end;
  147.  
  148. procedure TRichEditOleCallback.QueryInsertObject(const ClsID: TCLSID;
  149.   Stg: IStorage; CP: Integer);
  150. begin
  151.   //Accept anything
  152. end;
  153.  
  154. procedure TRichEditOleCallback.ShowContainerUI(fShow: Bool);
  155. var
  156.   Form: TCustomForm;
  157. begin
  158.   if fShow then
  159.   begin
  160.     Form := GetParentForm(FOwner);
  161.     if Assigned(Form) and Assigned(Form.Menu) then
  162.     begin
  163.       //Disassociate OLE menu handle from UI menu
  164.       Form.Menu.SetOle2MenuHandle(0);
  165.       //Make sure any space that was made for in-place toolbars is reclaimed
  166.       (Form.OleFormObject as IVCLFrameForm).ClearBorderSpace
  167.     end
  168.   end
  169. end;
  170.  
  171. { TOleRichEdit }
  172.  
  173. procedure TOleRichEdit.CreateHandle;
  174. begin
  175.   inherited;
  176.   Perform(em_SetOleCallback, 0,
  177.     Longint(TRichEditOleCallback.Create(Self) as IRichEditOleCallback))
  178. end;
  179.  
  180. procedure Register;
  181. begin
  182.   RegisterComponents('Clinic', [TOleRichEdit]);
  183. end;
  184.  
  185. end.
  186.